home *** CD-ROM | disk | FTP | other *** search
/ Ham Radio 2000 #1 / Ham Radio 2000.iso / ham2000 / packet / p_aa4re / bb212src / bbactlb.pas < prev    next >
Encoding:
Pascal/Delphi Source File  |  1992-01-06  |  14.1 KB  |  372 lines
  1. (*===========================================================================*)
  2. (* Validate and build action blocks                                          *)
  3. (*                                                                           *)
  4. (*   Copyright 1990, 1991, 1992 by H. Roy Engehausen.  All rights reserved.  *)
  5. (*                                                                           *)
  6. (*===========================================================================*)
  7.  
  8.   (*=========================================================================*)
  9.   (* Sub procedure to copy search blocks                                     *)
  10.   (*=========================================================================*)
  11.  
  12.   PROCEDURE copy_search_blocks;
  13.  
  14.     VAR
  15.       i : WORD;
  16.       n : search_block_ptr;
  17.       s : search_block_ptr;
  18.       o : search_block_ptr;
  19.  
  20.     BEGIN;
  21.  
  22.       (*---------------------------------------------------------------------*)
  23.       (* Initialize for loop                                                 *)
  24.       (*---------------------------------------------------------------------*)
  25.  
  26.       s := @search_info;
  27.       o := NIL;
  28.  
  29.       (*---------------------------------------------------------------------*)
  30.       (* Loop for each block                                                 *)
  31.       (*---------------------------------------------------------------------*)
  32.  
  33.       REPEAT
  34.  
  35.         (*-------------------------------------------------------------------*)
  36.         (* Test things                                                       *)
  37.         (*-------------------------------------------------------------------*)
  38.  
  39.         {$IFDEF POINT_CHK}
  40.           test_pointer(s);
  41.         {$ENDIF}
  42.  
  43.         i := length_search_block(s);
  44.         GETMEM(n, i);
  45.         MOVE(s^, n^, i);
  46.  
  47.         IF o = NIL THEN
  48.           new_msg_action^.action_srch := n
  49.         ELSE
  50.           o^.search_next := n;
  51.  
  52.         o := n;
  53.         s := s^.search_next;
  54.  
  55.       UNTIL s = NIL;
  56.  
  57.       free_task_mem(search_memory_block_id, TRUE);
  58.  
  59.     END;
  60.  
  61.   (*=========================================================================*)
  62.   (* Sub procedure to build an action block in memory for operations of      *)
  63.   (* the format "action search".  Note that the caller must still initialize *)
  64.   (* the action type                                                         *)
  65.   (*=========================================================================*)
  66.  
  67.   PROCEDURE build_format0_block;
  68.  
  69.     VAR i : WORD;
  70.  
  71.     BEGIN;
  72.  
  73.       (*---------------------------------------------------------------------*)
  74.       (* Get the search string                                               *)
  75.       (*---------------------------------------------------------------------*)
  76.  
  77.       s1 := subword(@s1, 2, 0);
  78.  
  79.       (*---------------------------------------------------------------------*)
  80.       (* If its missing then give error                                      *)
  81.       (*---------------------------------------------------------------------*)
  82.  
  83.       IF s1 = '' THEN
  84.         BEGIN;
  85.           send_tnc_data_str('No search in action file -- ' + s1 + cr);
  86.           active_tcb^.error_sw := TRUE;
  87.           EXIT;
  88.         END;
  89.  
  90.       (*---------------------------------------------------------------------*)
  91.       (* Test the search string                                              *)
  92.       (*---------------------------------------------------------------------*)
  93.  
  94.       test_search;
  95.       IF active_tcb^.error_sw THEN
  96.         EXIT;
  97.  
  98.       (*---------------------------------------------------------------------*)
  99.       (* Build a new action block                                            *)
  100.       (*---------------------------------------------------------------------*)
  101.  
  102.       i := LENGTH(s1) + 1 + WORD(action_msg_overhead);
  103.       GETMEM(new_msg_action, i);
  104.       FILLCHAR(new_msg_action^, i, #0);
  105.  
  106.       {$IFDEF DEBUG3}
  107.         trace_data('AC0', i , new_msg_action, s1);
  108.       {$ENDIF}
  109.  
  110.       (*---------------------------------------------------------------------*)
  111.       (* Initialize certain areas                                            *)
  112.       (*---------------------------------------------------------------------*)
  113.  
  114.       new_msg_action^.next_action := NIL;
  115.       new_msg_action^.action_srch := NIL;
  116.       new_msg_action^.action_info := s1;
  117.  
  118.       (*---------------------------------------------------------------------*)
  119.       (* Initialize the type field                                           *)
  120.       (*---------------------------------------------------------------------*)
  121.  
  122.       IF invert_flag THEN
  123.         new_msg_action^.action_type := action_msg_invert
  124.       ELSE
  125.         new_msg_action^.action_type := 0;
  126.  
  127.       (*---------------------------------------------------------------------*)
  128.       (* Copy over the search info                                           *)
  129.       (*---------------------------------------------------------------------*)
  130.  
  131.       copy_search_blocks;
  132.  
  133.       (*---------------------------------------------------------------------*)
  134.       (* Chain the block on the end of the list                              *)
  135.       (*---------------------------------------------------------------------*)
  136.  
  137.       chain_action;
  138.  
  139.     END;
  140.  
  141.   (*=========================================================================*)
  142.   (* Sub procedure to validate an action in the format of "action operand    *)
  143.   (* search".  At the end s1 = search and s2 = operand.                      *)
  144.   (*=========================================================================*)
  145.  
  146.   PROCEDURE validate_format1_statement;
  147.  
  148.     BEGIN;
  149.  
  150.       (*---------------------------------------------------------------*)
  151.       (* Throw away the verb                                           *)
  152.       (*---------------------------------------------------------------*)
  153.  
  154.       s1 := subword(@s1, 2, 0);
  155.  
  156.       (*---------------------------------------------------------------*)
  157.       (* Break the incoming line into two parts -- The search and      *)
  158.       (* the operand                                                   *)
  159.       (*---------------------------------------------------------------*)
  160.  
  161.       s2 := subword(@s1, 1, 1);
  162.       s1 := subword(@s1, 2, 0);
  163.       strip_var(s1, 'B');
  164.       strip_var(s2, 'B');
  165.  
  166.       (*---------------------------------------------------------------*)
  167.       (* Validate                                                      *)
  168.       (*---------------------------------------------------------------*)
  169.  
  170.       IF s2 = '' THEN
  171.         BEGIN;
  172.           send_tnc_data_str('There are no operands -- ' + s1 + cr);
  173.           active_tcb^.error_sw := TRUE;
  174.           EXIT;
  175.         END;
  176.  
  177.       IF s1 = '' THEN
  178.         BEGIN;
  179.           send_tnc_data_str('No search in action file -- ' + s1 + cr);
  180.           active_tcb^.error_sw := TRUE;
  181.           EXIT;
  182.         END;
  183.  
  184.       (*---------------------------------------------------------------*)
  185.       (* Test the search string                                        *)
  186.       (*---------------------------------------------------------------*)
  187.  
  188.       test_search;
  189.  
  190.       (*---------------------------------------------------------------*)
  191.       (* Now exit in all cases                                         *)
  192.       (*---------------------------------------------------------------*)
  193.  
  194.       EXIT;
  195.  
  196.     END;
  197.  
  198.   (*=========================================================================*)
  199.   (* Sub procedure to build an action block in memory for operations of      *)
  200.   (* the format "action operand search"  The operand is stored as a string   *)
  201.   (* following the search.  Note that the caller must still initialize the   *)
  202.   (* action type                                                             *)
  203.   (*=========================================================================*)
  204.  
  205.   PROCEDURE build_format1_block;
  206.  
  207.     VAR i : WORD;
  208.  
  209.     BEGIN;
  210.  
  211.       (*---------------------------------------------------------------------*)
  212.       (* Validate the statement and leave if error                           *)
  213.       (*---------------------------------------------------------------------*)
  214.  
  215.       validate_format1_statement;
  216.       IF active_tcb^.error_sw THEN EXIT;
  217.  
  218.       (*---------------------------------------------------------------------*)
  219.       (* Get memory for it                                                   *)
  220.       (*---------------------------------------------------------------------*)
  221.  
  222.       i := LENGTH(s1) + WORD(LENGTH(s2)) + 2 + action_msg_overhead;
  223.  
  224.       GETMEM(new_msg_action, i);
  225.       FILLCHAR(new_msg_action^, i, #0);
  226.  
  227.       {$IFDEF DEBUG3}
  228.         trace_data('AC1', i , new_msg_action, s1);
  229.       {$ENDIF}
  230.  
  231.       (*---------------------------------------------------------------------*)
  232.       (* Load the parms                                                      *)
  233.       (*---------------------------------------------------------------------*)
  234.  
  235.       new_msg_action^.next_action := NIL;
  236.       new_msg_action^.action_srch := NIL;
  237.       new_msg_action^.action_info := s1;
  238.  
  239.       str_ptr := ADDR(new_msg_action^.action_info[LENGTH(s1) + 1]);
  240.       str_ptr^ := s2;
  241.  
  242.       (*---------------------------------------------------------------------*)
  243.       (* Initialize the type field                                           *)
  244.       (*---------------------------------------------------------------------*)
  245.  
  246.       IF invert_flag THEN
  247.         new_msg_action^.action_type := action_msg_invert
  248.       ELSE
  249.         new_msg_action^.action_type := 0;
  250.  
  251.       (*---------------------------------------------------------------------*)
  252.       (* Copy over the search info                                           *)
  253.       (*---------------------------------------------------------------------*)
  254.  
  255.       copy_search_blocks;
  256.  
  257.       (*---------------------------------------------------------------------*)
  258.       (* Chain the block on the end of the list                              *)
  259.       (*---------------------------------------------------------------------*)
  260.  
  261.       chain_action;
  262.  
  263.     END;
  264.  
  265.   (*=========================================================================*)
  266.   (* Sub procedure to build an action block in memory for operations of      *)
  267.   (* the format "action operand search"  The operand is stored as a WORD     *)
  268.   (* following the search.  Note that the caller must still initialize the   *)
  269.   (* action type                                                             *)
  270.   (*=========================================================================*)
  271.  
  272.   PROCEDURE build_format2_block(low_num : WORD; hi_num : WORD);
  273.  
  274.     VAR
  275.       code  : INTEGER;
  276.       i     : WORD;
  277.       num   : WORD;
  278.       w_ptr : ^WORD;
  279.  
  280.     BEGIN;
  281.  
  282.       (*---------------------------------------------------------------------*)
  283.       (* Validate the statement and leave if error                           *)
  284.       (*---------------------------------------------------------------------*)
  285.  
  286.       validate_format1_statement;
  287.       IF active_tcb^.error_sw THEN EXIT;
  288.  
  289.       (*---------------------------------------------------------------------*)
  290.       (* Now get the numberer                                                *)
  291.       (*---------------------------------------------------------------------*)
  292.  
  293.       IF (LENGTH(s2) > 5) THEN
  294.         BEGIN;
  295.           send_tnc_data_str('The numeric operand is too long -- ' + s2 + cr);
  296.           active_tcb^.error_sw := TRUE;
  297.           EXIT;
  298.         END;
  299.  
  300.       IF s2[1] = '-' THEN
  301.         BEGIN;
  302.           send_tnc_data_str('The numeric operand cannot be negative -- '
  303.                              + s2 + cr);
  304.           active_tcb^.error_sw := TRUE;
  305.           EXIT;
  306.         END;
  307.  
  308.       VAL(s2, num, code);
  309.  
  310.       IF code <> 0 THEN
  311.         BEGIN;
  312.           send_tnc_data_str('Invalid numeric operand -- '
  313.                              + s2 + cr);
  314.           active_tcb^.error_sw := TRUE;
  315.           EXIT;
  316.         END;
  317.  
  318.       IF (num < low_num) OR (num > hi_num) THEN
  319.         BEGIN;
  320.           send_tnc_data_str('Numeric operand out of bounds -- '
  321.                              + s2 + cr);
  322.           active_tcb^.error_sw := TRUE;
  323.           EXIT;
  324.         END;
  325.  
  326.       (*---------------------------------------------------------------------*)
  327.       (* Get memory for it                                                   *)
  328.       (*---------------------------------------------------------------------*)
  329.  
  330.       i := LENGTH(s1) + WORD(SIZEOF(WORD)) + 1 + action_msg_overhead;
  331.  
  332.       GETMEM(new_msg_action, i);
  333.       FILLCHAR(new_msg_action^, i, #0);
  334.  
  335.       {$IFDEF DEBUG3}
  336.         trace_data('AC2', i , new_msg_action, s1);
  337.       {$ENDIF}
  338.  
  339.       (*---------------------------------------------------------------------*)
  340.       (* Load the parms                                                      *)
  341.       (*---------------------------------------------------------------------*)
  342.  
  343.       new_msg_action^.next_action := NIL;
  344.       new_msg_action^.action_info := s1;
  345.       new_msg_action^.action_srch := NIL;
  346.  
  347.       w_ptr := ADDR(new_msg_action^.action_info[LENGTH(s1) + 1]);
  348.       w_ptr^ := num;
  349.  
  350.       (*---------------------------------------------------------------------*)
  351.       (* Initialize the type field                                           *)
  352.       (*---------------------------------------------------------------------*)
  353.  
  354.       IF invert_flag THEN
  355.         new_msg_action^.action_type := action_msg_invert
  356.       ELSE
  357.         new_msg_action^.action_type := 0;
  358.  
  359.       (*---------------------------------------------------------------------*)
  360.       (* Copy over the search info                                           *)
  361.       (*---------------------------------------------------------------------*)
  362.  
  363.       copy_search_blocks;
  364.  
  365.       (*---------------------------------------------------------------------*)
  366.       (* Chain the block on the end of the list                              *)
  367.       (*---------------------------------------------------------------------*)
  368.  
  369.       chain_action;
  370.  
  371.     END;
  372.